home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM B4 / PD-ROM B4.iso / Utilities / Text and Speech / Alpha 5.3 / Tcl / Usercode / setBackupFolder.tcl < prev    next >
Encoding:
Text File  |  1993-01-24  |  3.1 KB  |  122 lines  |  [TEXT/ALFA]
  1. # FILE: setBackupFolder.tcl
  2. #
  3. # LAST UPDATE: 01/24/93 3:46:17 PM
  4.  
  5. # setBackupFolder = sets the backup folder based on location of file being
  6. # edited.  If folder named "$backName" is found relative to the file's location
  7. # or relative to any folder above, then that is used.  If no "$backName" folder
  8. # is found, then turn off backupFolder.  Thus the following hypothetical volume
  9. # has respective backup files:
  10. #
  11. # HD
  12. # :Backup:
  13. # ::Addresses.bak
  14. # :Lists:
  15. # ::Addresses
  16. # :Misc:
  17. # ::Letters:
  18. # :::Project RFQ
  19. # ::Backup:
  20. # :::Project RFQ.bak
  21. # ::Memos:
  22. # :::Backup:
  23. # ::::Organization.bak
  24. # :::Organization
  25. # Floppy:
  26. # :Readme
  27. # :Readme.bak
  28. #
  29. # To use, source this file.  It redefines activateHook & saveasHook,
  30. # keeping the old definitions as original-activateHook & original-saveHook.
  31. # A good place to source this is either from $HOME:AlphaBits.tcl (at the
  32. # end) or $HOME:UserBits.tcl
  33.  
  34. # COPYRIGHT:
  35. #
  36. #    Copyright © 1992,1993 by David C. Black All rights reserved.
  37. #    Portions copyright © 1990, 1991, 1992 Pete Keleher. All Rights Reserved.
  38. #
  39. #    Redistribution and use in source and binary forms are permitted
  40. #    provided that the above copyright notice and this paragraph are
  41. #    duplicated in all such forms and that any documentation,
  42. #    advertising materials, and other materials related to such
  43. #    distribution and use acknowledge that the software was developed
  44. #    by David C. Black in conjunction with Pete Keleher.
  45. #
  46. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  47. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  48. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  49. #
  50. ################################################################################
  51.  
  52. # AUTHOR
  53. #
  54. #    David C. Black
  55. #    Internet: black@mpd.tandem.com (preferred)
  56. #    GEnie:    D.C.Black
  57. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  58. #
  59. ################################################################################
  60.  
  61. set backupDir ":BackUp"
  62. proc setBackupFolder {} {
  63.     global backupDir
  64.     global backupFolder
  65.     global backupFolderName
  66.     set wins [winNames -f]
  67.     if {[llength $wins] == 0} {
  68.         return
  69.     } else {
  70.         set folder [lindex $wins 0]
  71.     }
  72.     if {[regexp {^Untitled [0-9]+$} $folder]} {
  73.         return
  74.     }
  75.     if {[regexp {^[*].*[*]$} $folder]} {
  76.         # Ignore "*tcl shell*" and the like
  77.         return
  78.     }
  79.     while {[string first ":" $folder] >= 0} {
  80.         set folder  [file dirname $folder]
  81.         if ([file isdirectory "$folder$backupDir"]) {
  82.             set backupFolderName "$folder$backupDir"
  83.             set backupFolder 1
  84.             # message $backupFolderName
  85.             return
  86.         }
  87.     }
  88.     append folder "$backupDir"
  89.     if ([file isdirectory "$folder"]) {
  90.         set backupFolderName "$folder"
  91.         set backupFolder 1
  92.     } else {
  93.         set backupFolder 0
  94.     }
  95.     # message $backupFolderName
  96. }
  97.  
  98. if {[info procs original-saveasHook] != "original-saveasHook"} {
  99.  
  100. rename saveasHook original-saveasHook
  101.  
  102. proc saveasHook {oldName newName} {
  103.     setBackupFolder
  104.     set result [eval original-saveasHook {$oldName} {$newName}]
  105.     return $result
  106. }
  107. #endproc saveasHook
  108.  
  109. rename activateHook original-activateHook
  110.  
  111. proc activateHook name {
  112.     setBackupFolder
  113.     set result [eval original-activateHook {$name}]
  114.     return $result
  115. }
  116. #endproc activateHook
  117.  
  118. }
  119. #endif
  120.  
  121. setBackupFolder
  122.